home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tegl6b.zip / INTROPAK.EXE / lha / TSTEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-10  |  3KB  |  126 lines
  1.  
  2. {$M 20000,0,655360}
  3.        {-- Defaults }
  4. {$A-}  {-- A- byte alignment }
  5. {$B-}  {-- B- short circuit boolean evaluation }
  6. {$D+}  {-- D- No debug info }
  7. {$E-}  {-- E- No emulation }
  8. {$F-}  {-- F- Far calls only when necessary }
  9. {$I-}  {-- I- I/O error checking done internally }
  10. {$L+}  {-- L- No local symbols }
  11. {$N-}  {-- N- Software reals }
  12. {$R-}  {-- R- Range checking off }
  13. {$S-}  {-- S- Stack overflow off }
  14. {$V-}  {-- V- No strict type checking }
  15.  
  16. uses crt,
  17.      tegledit,
  18.      errorlog,
  19.      virtmem,
  20.      teglfnt2,
  21.      teglfont,
  22.      teglicon,
  23.      ipstacks,
  24.      teglmain,
  25.      tgraph,
  26.      teglintr,
  27.      teglunit,
  28.      fastgrph;
  29.  
  30.  
  31.  
  32. var mystr1 : string;
  33.     mystr2 : string;
  34.  
  35.     mystrfs  : imagestkptr;
  36.     mystr1ms : msclickptr;
  37.     mystr2ms : msclickptr;
  38.  
  39.  
  40. {$F+}
  41. Function ExitOption(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  42. {$F+}
  43.    BEGIN
  44.       logmessage(mystr1);
  45.       Abortexit(mystr2);
  46.       exitoption := 1;
  47.    END;
  48.  
  49.  
  50. {$F+}
  51. Function MyDoneEvent(fs:ImageStkPtr; ms: MsClickPtr) : Word;
  52. {$F+}
  53.    begin
  54.       if visualbuttonpress(fs,ms) then
  55.      dropstackimage(fs);
  56.  
  57.       MyDoneEvent := 1;
  58.    end;
  59.  
  60. {$F+}
  61. function StrPackformat(var txtstr:string):boolean;
  62. {$F-}
  63.    var pack : boolean;
  64.        i    : byte;
  65.    begin
  66.       i := pos(' ',txtstr);
  67.       pack := i<>0;
  68.       while i<>0 do
  69.      begin
  70.         delete(txtstr,i,1);
  71.         i := pos(' ',txtstr);
  72.      end;
  73.  
  74.       strpackformat := pack;
  75.    end;
  76.  
  77. procedure CreateEditBox;
  78.    var x,y,x1,y1: word;
  79.        fs : imagestkptr;
  80.    begin
  81.       x  := 100;
  82.       y  := 10;
  83.       x1 := x+300;
  84.       y1 := y+100;
  85.  
  86.       mystr1 := 'This is an initialized String from mystr1';
  87.       mystr2 := 'This is an initialized String from mystr2';
  88.  
  89.       pushimage(x,y,x1,y1);
  90.       fs := stackptr;
  91.       mystrfs := stackptr;
  92.  
  93.       SetFillPattern(gridfill,darkgray);
  94. {     SetFillStyle(solidfill,darkgray); }
  95.       BevelBox(x,y,x1,y1,white,lightgray,red,5);
  96.  
  97.       setkeyboardmouse(false);
  98.       DefineStrEditEvent(fs,10,10,290,30,254,white,@font14,true,
  99.              mystr1,Allchars,StrPackFormat,StrPackformat,nilunitproc);
  100.       mystr1ms := fs^.msptr;
  101.       DefineStrEditEvent(fs,10,35,290,55,254,white,@cour25,true,
  102.              mystr2,NumbersOnly,StrNoFormat,StrRedisplay,nilunitproc);
  103.       mystr2ms := fs^.msptr;
  104.  
  105.       prepareforupdate(fs);
  106.       Putpict(x1-60,y1-25,@imageok,black);
  107.       DefineMouseClickArea(fs,(x1-x)-60,(y1-y)-25,(x1-x)-60+37,(y1-y)-25+14,TRUE,MyDoneEvent,MSCLICK);
  108.       CommitUpdate;
  109.  
  110.       AddCaptureKey($001C,FALSE,CRClickPress);
  111.       AddCaptureKey($009C,TRUE,CRClickRelease);
  112.    end;
  113.  
  114.  
  115. begin
  116.    EasyTegl;
  117.    EasyOut;
  118.  
  119.    DefineGlobalKeyClickArea(NIL,NIL,$082d,false,exitoption); {-- Alt-X}
  120.  
  121.    createeditbox;
  122.    setstredit(mystrfs,mystr2ms,1);
  123.  
  124.    TEGLSupervisor;
  125. end.
  126.